perm filename NOTWRT.OLD[MSS,LCS] blob
sn#137980 filedate 1975-01-01 generic text, type T, neo UTF8
00200 SUBROUTINE NOTWRT
00300 IMPLICIT INTEGER(A-Q,S-Z)
00400 COMMON/DL/IXRX,M,AA /FONT/JFONT
00500 COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600 DIMENSION RACNT(65),RDOT(7),XAC(7),RNOTE(22)
00700 REAL DIS,PWDS,CENTR,POS,STFF
00800 COMMON /STF/RSTFAC(-3/4),RSTJ3
00900 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000 COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01200 COMMON /NU/NUMQ(44),RNUMS(327),RACCI(22),NACCI(3)
01300 C FOR NOTE DRAWING
01310 COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01320 1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01330 1 PUNCT,RDIS,RJ
01400 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01500 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01600 1,(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3))
01700 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20))
01800 DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
01900 1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02000 1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02100 1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02200 1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02300 1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
02305 1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
02307 1 18.103, 12.003, 6.103, 0.003, 106.103/
02310 1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
02340 1 1000.0, 7.007, 14.0, 7.107, 0, 1000.107, 14.007,
02370 1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
02400 DATA RDOT/1000.0, 0.103, 1.0, 1.103, 2.0, 2.103,0/
02500 1 , R5/5.0/, R66/66.0/, R72/72.0/,R18/18.0/,RSTM/14.54/
02600 1 ,XAC/9,14,18,28,33,44,53/
02700 C ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
02900 RST7=7.*RSTJ3
03200
03300 CC1 CALL CENTX
03400 C 'CENTR' IS VERTICAL PLACEMENT
03510 RST3=3.*RSTJ3
03520 RSTX=RSTJ3
03560 C FOR MINIS AT 245
03600 RMINI=RSTJ3
03700 C OR SHOULD THIS ONLY BE IN NOTES, ETC? 15/9/72
03800
04100 RINV=1
04200 IF(JA.EQ.1)GO TO 11
04400 IF(JA.EQ.6)GO TO 242
04700
04750 C NEXT IS FOR RESTS
04800 IF(J5.GT.1)R4=R4-2
04900 CC RA=R4
05000 R7=R6*10.
05100 C FOR DOTS
05200 202 CALL REST
05300 IF(J5.GT.1)GO TO 200
05400 IF(R7.EQ.0)RETURN
05900 201 RA=14
05950 R6=0
06000 IF(J5)RA=19
06100 R2=R2+RA*RSTJ3
06200 R4=8.+R4
06300 JA=6
06400 J5=7
06500 C IF P6=1 THE REST IS DOTTED
06600 CALL CENTX
06650 GO TO 242
06700 200 J5=J5-1
06800 C FOR MULTIPLE TAILS ON 16TH REST, ETC.
06900 R4=R4+2.
07000 CALL RJBX(4.3)
07100 GO TO 202
07200
10200 29 RJX=R2
10300 RJY=CENTR+RSTJ3
10400 108 CALL RDRAW(1,7.0,RDOT,RMINI,RJX,RJY,RMINI)
10410 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ3 11/74
10500 IF(JA.EQ.1.OR.R7.GE.20.)GO TO 290
10600 RB=POS+52.*RSTJ3
10700 IF(RJY.NE.RB)GO TO 6241
10800 C WHERE IS RB USED LATER?
10900 RJY=RJY-12*RSTJ3
11000 GO TO 108
11100 C ABOVE FOR DOTS
11200 290 R7=R7-10.
11300 IF(R7.LT.10.)GO TO 1342
11400 RJX=RJX+RSTJ3*10.
11500 GO TO 108
11600
11700
11800 C FOR LEDGER LINES
11900 70 J11=J4
12000 C NOTE #
12100 170 RJW=R2-7.*RMINI
12200 RZ=R2+20.*RMINI
12300 IF(J11)GO TO 71
12400 JX=J11
12500 JRX=13
12600 C********* 18/9/72
12700 GO TO 711
12800 71 JX=-J11
12900 JRX=J11*2+3
13000 711 RX=POS-18*RSTJ3+RST7*JRX
13100 C********* 18/9/72
13200 IF(J6)RZ=RZ+2*RMINI
13300 C126 IF(PLT.EQ.-3)GO TO 1126
13400 C FOR 2-PASS PLOTTING
13500 C ******* ABOVE IS NOT USED, 15/9/72
13600 126 CALL LINX(RJW,RX,RZ,RX)
13700 1126 IF(JX.EQ.1)GO TO 1122
13800 RX=RX+RSTJ3*14.
13900 JX=JX-1
14000 GO TO 126
14200 1122 J9=-1
14300 GO TO 1121
14400
14500 C NOTES****
14600 11 JY=0
14610 IF(R6.EQ.0)GO TO 1015
14620 JY=IABS(J6)
14700 R6=ABS(AMOD(R6,1.0))*10.
14800 C R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
15500 1015 L=IABS(J4)
15600 STEM=J5/10
15700 IF(L.LT.100)GO TO 1221
15800 IF(L.LT.200)GO TO 1012
16000 IF(L.GE.300)GO TO 1014
16010 KL=8
16100 RG=12.0
16200 C FOR DIAMOND NOTES.
16300 GO TO 1013
16400 1014 RJX=RMINI*7
16410 C FOR "X" NOTES.
16500 KL=13
16600 RG=16.
16700 RB=CENTR+RJX
17000 IF(STEM.EQ.2)RB=CENTR-RJX
17100 GO TO 1013
17200 1012 RMINI=.6*RSTJ3
17300 C FOR RMINI NOTES
17600 1013 R4=AMOD(R4,100.)
17625 J4=R4
17700 CC IF(R4.GT.160.)GO TO 1013
17800 C FOR MINI TAILS AND ACCIS. ETC.
17910 1221 RJZ=R4
17920 C SAVES IT FOR RESET IN 'DRWNT'.
17940 RX4=R4
17980 RJAC=R2
17990 C TO SAVE POS. OF NOTE FOR ACCENT
18000 IF(JY.LT.10.OR.JY.GE.30)GO TO 2221
18100 C P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
18200 C P6<0 = WHITE NOTE
18300 RQ=RSTM
18400 IF(J6)RQ=RQ+1.66
18500 C GETS WIDTH OF NOTE DISPLACEMENT
18600 IF(JY.EQ.20)RQ=-RQ
18700 R2=R2+RQ*RMINI
18800 2221 IF(J4.GT.1.AND.J4.LT.13)GO TO 1121
18850
18860 IF(J9)GO TO 1121
18900 C ARE THERE LEDGER LINES? P9=-1 SUPPRESSES THEM.
19000 J11=(J4+1)/2-6
19100 IF(J11)J11=-((3-J4)/2)
19200 GO TO 170
19300 C IF J6≠0 NOTE IS FILLED IN
19400 1121 IF(J6.GE.0.AND.L.LT.200)GO TO 125
19410 KL=1
19420 RG=7.
19430 C FOR WHITE NOTES ON DPY.
19500 IF(PLT.GE.0.OR.L.GE.200)GO TO 1253
19805 2121 J5=15
19807 RG=RSTJ3
19808 C FIX THIS SOME DAY↓↓ SEE 1342+1!
19810 CCXX IF(RMINI.NE.RSTJ3)RSTJ3=.7*RSTJ3
19820 CC IF(J7.NE.R7)J5=6
19825 IF(MOD(J7,10).NE.0)J5=16
19830 C 1 ADDED TO P7 MAKES A WHOLE NOTE(6) INSTEAD OF HALF(5).
19832 C THESE NOTES ARE IN CLEF4. 1/2=43 WHOLE=44
19835 JX4=J4
19837 C SAVE IT FOR DOTS
19840 CALL DRWNT(RMINI)
19842 J4=JX4
19843 C GET IT BACK
19845 RSTJ3=RG
19850 C DRAWS GOOD NOTES ON PLOTTER -- NOT ON DPY.
19860 CC DONE IN DRWNT R7=J7
19870 C TO RESET IT.
20200 GO TO 123
20300 1251 CALL NOIR(RMINI)
20310 C FOR QUARTER NOTES ON PLOTTER.
20400 GO TO 123
20500
20600 125 IF(PLT)GO TO 1251
20700 KL=17
20800 RG=22.
21300 C ABOVE IS NEW NOTES ROUTINE
21310 1253 CALL RDRAW(KL,RG,RNOTE,RMINI,R2,CENTR,RMINI)
21400
21500 123 R5=R5-J5
21600 C R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
21700 IF(STEM.EQ.0)GO TO 1242
21800 IF(L.LT.300)RB=CENTR+2
21850 C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ +2
21900 C ≥300 IS FOR 'X' NOTES.
22000 128 J7=MOD(J7,10)
22100 RG=(J7-1)*14
22200 IF(RG)RG=0
22270 IF(R8.EQ.999)R8=0
22300 IF(R8.LT.999)GO TO 751
22375 R8=R8-1000.
22387 J10=1
22393 C 1000+ PUTS SLASH ON NOTE STEM
22500 751 RH=R8*RST7
22600 C STEM EXTENSIONS ARE BY NOTE #S
22700 IF(STEM.NE.2)GO TO 1280
22800 RJX=R2
22900 C FOR STEM DOWN (=2)
23000 RG=-RG-48.
23100 RH=-RH
23200 L=20
23300 CC RJY=3.
23750 RB=RB-4
23760 C************↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ SEE 21800 12/74
23800 GO TO 129
23900 C NEXT IS FOR STEM UP.
24000 1280 RJX=RSTM
24500 IF(J6.NE.0.AND.J6.NE.30)RJX=16.2
24600 C FOR HALF NOTES
24700 RJX=RJX*RMINI+R2
24800 RG=RG+48.
24900 L=10
25000 CC RJY=-3.
25200 129 RZ=CENTR+RH+RG*RMINI
25300 IF(RMINI.NE.RSTJ3)RJW=RJW*.6
25400 CALL LINX(RJX,RB,RJX,RZ)
25500 C RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
25600 227 J5=J5-L
25700 C J5 HAS ACCID. # NOW
25800 IF(J7.EQ.0)GO TO 1242
25900 C JUMP IF NO TAILS
25910 IF(STEM.NE.2)GO TO 1127
25920 R4=R4-3.7-R8
25930 C R4 IS USED IN SUBR. TAIL - R8 IS STEM EXTENSION.
25940 RJW=-2
25950 RA=1.
25960 GO TO 127
25970 1127 RJW=2
25977 C FOR VERT. SPACING OF MULTIPLE TAILS
25984 R4=R4-2+R8
25991 C 2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
25996 RA=-1.
26000 127 CALL TAIL(RJX,RA,RMINI)
26100 1028 J7=J7-1
26200 IF(J7.EQ.0)GO TO 327
26300 R4=R4+RJW
26400 C MOVES CENTR UP OR DOWN FOR NEXT TAIL
26500 GO TO 127
26562 327 IF(R4.GE.RX4)RX4=R4+1
26575 C FOR TRILLS, ETC.
26600 IF(J10.EQ.0)GO TO 1242
26700 RJY=RZ-19*RSTJ3
26800 RZ=RZ-RSTJ3*4.
26900 IF(RA.LT.0)GO TO 1327
27000 C NEXT IS FOR STEM DOWN SLASH
27100 RJY=RZ+23*RSTJ3
27200 RZ=RZ+RST7
27300 1327 RJX=RJX-RST7
27400 CALL LINX(RJX,RJY,RJX+17.*RSTJ3,RZ)
27500 C FOR SLASH ON GRACE NOTE TAIL
27600 1242 IF(R7.LT.10.)GO TO 1342
27700 C FOR DOTTED NOTE-- P7>9
27800 RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
27850 C***↑↑↑↑↑ WAS 24. 11/74
27900 RJY=CENTR+RSTJ3
28000 IF(JY.EQ.10.OR.JY.EQ.30)RJX=RJX+RSTM
28100 C MOVES DOT TO LEFT
28200 IF(MOD(J4,2).EQ.0)GO TO 108
28300 RX=RST7
28400 IF(JY.GE.20)RX=-RX
28500 3342 RJY=RJY+RX
28600 GO TO 108
28700 C JY=30= STEM UP, INTERVAL OF SECOND.
28710 1342 IF(R6.EQ.0.AND.J5.EQ.0)RETURN
28800 R2=R2-R5*59.6*RMINI
28900 C TO SPACE OUT ACCIDS.
29000 CCXX IF(RMINI.NE.RSTJ3)RSTJ3=.7*RSTJ3
29100 C ↑↑↑↑ ↑↑↑↑↑ WAS RMINI
29200 C********* 18/9/72
29300 242 IF(J5.GE.0)GO TO 2421
29400 RINV=-RINV
29500 J5=-J5
29600 C NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
29700 C********** LAST # WAS 281?
29800 C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
29900 CXX 11/74 2421 RH=14
29910 2421 J5X=-1
30000 IF(JA.NE.6)GO TO 211
30050 RJZ=AMOD(R4,100.)
30075 C FOR 'DRWNT' WHEN PLOTTING.
30100 CALL NOZERO(R6)
30200 C R6=SIZE FACTOR (P6)
30300 RMINI=RMINI*R6
30400 R6=0
30500 STEM=0
30600 C FOR MISC. ITEMS
30700 210 IF(IABS(J4).LT.100)GO TO 1241
30710 CC210 IF(IABS(J4).LT.100)GO TO 3241
30800 J4=MOD(J4,100)
30900 RMINI=.7*RMINI
31000 CC3421 J5X=-1
31100 C FOR 2 MARKS AT ONCE.
31200 1241 IF(J5.GE.11)GO TO 28
31300 GO TO (211,211,211,28,28,222,249,60,27,27),J5
31400 RETURN
31500 C ERROR TRAP (I.E. J5=0)
31510 C FOR 1 OR 2 BAR REP SIGNS.
31555 60 CALL BREP(R2,RSTJ3)
31577 RETURN
31600
31700 241 CALL LINES(R2,CENTR,3)
31800 GO TO 210
31900
31910 211 IF(J5.EQ.0)GO TO 2422
31917 C GETS BACK GOOD VERTICAL POS.
31920 IF(J5.GT.3)GO TO 222
31930 C FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
31940 IF(PLT.OR.JFONT)GO TO 3121
31950 X=NACCI(J5)
31960 CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R2,CENTR,RMINI)
32000 2422 IF(R6.EQ.0)RETURN
32010 R4=RX4
32100 R2=RJAC
32200 J5=(R6+.001)*100.
32300 1249 IF(MOD(J5,10).GT.3)GO TO 249
32400 J5=J5/10
32500 IF(J5.GT.30)GO TO 1249
32600 C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
32700 249 IF(J5.GT.30)GO TO 28
32800 IF(J5.GT.10)GO TO 246
32900 IF(JA.NE.1)GO TO 250
33000 CXX 11/74 RH=8
33100 RB=14.
33200 IF((J5.NE.7.AND.J5.NE.9).OR.MOD(J4,2).EQ.0)GO TO 244
33300 IF((STEM.LE.1.AND.J4.LT.5).OR.((STEM.EQ.2.OR.STEM.EQ.0)
33400 1 .AND.J4.GT.9))GO TO 244
33500 RB=21
33600 C PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
33700 244 IF(STEM.EQ.1.OR.(STEM.EQ.0.AND.J4.LT.7))RB=-RB
33800 IF(J5.NE.6)GO TO 245
33900 IF(J4.LT.9.AND.STEM.EQ.2)GO TO 247
34000 IF(J4.GT.4.AND.STEM.EQ.1)GO TO 252
34100 245 CENTR=CENTR+RB*RSTX
34200 250 IF(J5.GT.10.OR.J5.LT.6)GO TO 247
34300 JA=6
34400 IF(J5.NE.7)GO TO 253
34500 C 7=DOT
34600 RXX=R2
34700 R2=R2+6.7*RMINI
34800 C CENTERS THE DOT
34900 GO TO 29
35000 253 IF(J5.EQ.9)GO TO 271
35100 C 9=DASH
35200 251 IF(RB.LT.0)RINV=-RINV
35300 C FIX THIS!!!! FOR BOWINGS, ETC.
35310 2222 IF(J5.NE.20)GO TO 2223
35320 JA=20
35330 R5=0
35340 J7=1
35342 R4=R4+3
35345 IF(STEM.EQ.1)R4=R4+6.
35347 IF(R4.LT.12.5)R4=12.5
35350 CALL ALPHA
35360 C FOR TRILL -- J5=20
35370 RETURN
35380 2223 IF(J5.EQ.17.OR.J5.EQ.18)RINV=J5
35390 C FOR MORD, INV.MORD
35400 222 CALL FERMTA(RINV)
35500 GO TO 5241
35600 252 RX=POS
35700 248 CENTR=RX
35800 GO TO 251
35900 246 IF(STEM.EQ.1)RB=70.
36000 IF(STEM.EQ.2)RB=21.
36100 C CHANGE R66 AND R72 TO NUMS WHEN RIGHT ONES ARE FOUND.
36200 GO TO 245
36300 247 RX=POS+R72*RSTJ3
36400 IF(J5.EQ.6.OR.J5.EQ.26)GO TO 248
36500 C 26 IS NEW NUMB FOR FERMATA. TAKE OUT 6 EVENTUALLY.
36600 IF(JA.EQ.1.AND.J5.GT.10.AND.CENTR.LT.RX)CENTR=RX
36700 28 IF(J5.LT.30)GO TO 281
36800 J5X=MOD(J5,10)
36900 C J5X SAVES NEXT MARK.
37000 IF(J5X.LT.4)J5X=0
37100 J5=J5/10
37200 IF(J5.GT.30)RETURN
37300 C WON'T READ 415 ETC. (CORRECT=154)
37400 C DOES BOTTOM MARK FIRST, THEN TOP.
37500 CALL EXCH(J5X,J5)
37600 C PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
37700 IF(JA.EQ.1)GO TO 249
37800 GO TO 1241
37900 281 X=1
37950 IF(J5.GT.16)GO TO 2222
37975 C JUMP FOR MORD, INV.MORD, TRILL
38000 IF(J5.NE.4)GO TO 228
38100 X=5
38200 CALL RJBX(.5)
38300 GO TO 328
38400 228 IF(J5.GT.10)X=XAC(J5-10)
38500 C X IS POINTER IN RACNT ARRAY
38600 328 RA=RMINI
38700 C OR RSTJ3?
38800 IF(RINV.LT.0.OR.(STEM.EQ.1.AND.J5.EQ.4))RA=-RA
38850 C ↓↓↓ X ↓↓↓ PICKS UP TYPO ERRORS
38900 IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R2,CENTR,RMINI)
39000 C PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
39100 C IN ARRAY, 33.012 WOULD BE X=33, Y=12. 101.123 IS X=-1, Y=-23.
39200 GO TO 5241
39300 4241 JJJ=J5
39400 J5=J5X
39500 J5X=-1
39600 IF(JA.NE.1)GO TO 7241
39700 IF(J5.GT.10)GO TO 246
39800 IF(J5.EQ.7.AND.JJJ.NE.9)GO TO 249
39900 7241 RXX=8.5*RMINI
39950 C↑↑↑↑↑↑ 11/74 WAS RH*
40000 IF(STEM.EQ.1)RXX=-RXX
40100 CENTR=CENTR+RXX
40200 IF(J5.EQ.26)J5=6
40300 C TEMPORARY?? FIX
40400 GO TO 1241
40500 C >=5, ∧=4
40600 27 R2=J2
40700 C DASHES
40800 271 CALL LINX(R2,CENTR,R2+RMINI*14.,CENTR)
40850 C **** **** *** ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ3 11/74
40900 5241 IF(J5X.GT.0)GO TO 4241
41000 C J5X IS FOR DOUBLE MARKS. (WHAT ABOUT DOT POSITION.)
41100 RETURN
41200 6241 R2=RXX
41300 C RESET R2 AFTER A DOT.
41400 GO TO 5241
42010 3121 J5=J5+9
42015 C SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
42020 C TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
42030 CALL DRWNT(RMINI)
42040 GO TO 2422
50200 END